home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / databnch / local.fcm < prev    next >
Text File  |  1993-05-27  |  28KB  |  923 lines
  1. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  2. C                                                                    C
  3. C                                                                    C
  4. C      Benchmark Program for data parallel operations                C
  5. C                                                                    C
  6. C      Local  Operations (single, double, integer)                   C
  7. C                                                                    C
  8. C      ADAPTOR Version 1.0                                           C
  9. C                                                                    C
  10. C      Author: Dr. Thomas Brandes, GMD, I1.HR                        C
  11. C      Date:   December, 1992                                        C
  12. C                                                                    C
  13. C      measures:                                                     C
  14. C                                                                    C
  15. C         - movements, initializations                               C
  16. C         - binary operations                                        C
  17. C         - axpy, complex operations                                 C
  18. C         - intrinsic functions                                      C
  19. C                                                                    C
  20. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  21.  
  22.       program benchmark
  23.       integer nproc, size, npts, nops, op, nflop, initsize
  24.       integer i, j, k, number, step
  25.       parameter (initsize = 16)
  26.       parameter (npts = 13)
  27.       real time (npts), tover
  28.       real usec, mflops, mops
  29. cmf$  layout time(:serial)
  30.       write (6,*) 'Input number of processors : '
  31.       read (5,*) nproc
  32.       call overhead (tover)
  33.  
  34.       write (6,*) '==============================================='
  35.       write (6,*) '|                                             |'
  36.       write (6,*) '| ADAPTOR BENCHMARK PROGRAM by Thomas Brandes |'
  37.       write (6,*) '|                                             |'
  38.       write (6,*) '|     Simple  Operations                      |'
  39.       write (6,*) '|                                             |'
  40.       write (6,*) '==============================================='
  41.       write (6,*) ' '
  42.       write (6,*) 'BENCHMARK FOR P = ', nproc
  43.       write (6,*) '==============================='
  44.       write (6,*) ' '
  45. c
  46. c     testing moving operations
  47. c
  48.       step = 1
  49.       write (6,*) ' '
  50.       write (6,*) 'ADAPTOR:    moving operations'
  51.       write (6,*) '=============================='
  52.       write (6,*) ' '
  53.       write (6,*) ' z (1:size*nproc) = ... '
  54.       write (6,*) ' '
  55.  
  56.       do k = 1, 3
  57.        do op = 1, 5
  58.          size = initsize
  59.          do i = 1, npts
  60.             if (k .eq. 1) call smoves (op, size, nproc, time(i))
  61.             if (k .eq. 2) call dmoves (op, size, nproc, time(i))
  62.             if (k .eq. 3) call imoves (op, size, nproc, time(i))
  63.             time(i) = time(i) - tover
  64.             size = size * 2
  65.          end do
  66.          call info (step, op, k, nflop)
  67.          call output (initsize,time, npts, nflop, nproc)
  68.        end do  ! loop for op
  69.       end do ! loop for k
  70. c
  71. c     testing binary operations
  72. c
  73.       step = 2
  74.       write (6,*) ' '
  75.       write (6,*) 'ADAPTOR:    binary operations'
  76.       write (6,*) '============================='
  77.       write (6,*) ' '
  78.       write (6,*) ' z (1:size,1:nproc) = x(:,:) op y(:,:) '
  79.       write (6,*) ' '
  80.  
  81.       do k = 1, 3
  82.        do op = 1, 6
  83.          size = initsize
  84.          do i = 1, npts
  85.             if (k .eq. 1) call sbinops (op, size, nproc, time(i))
  86.             if (k .eq. 2) call dbinops (op, size, nproc, time(i))
  87.             if (k .eq. 3) call ibinops (op, size, nproc, time(i))
  88.             time(i) = time(i) - tover
  89. c           write (6,*) 'size = ', size, ' time = ', time(i)
  90.             size = size * 2
  91.          end do
  92.          call info (step, op, k, nflop)
  93.          call output (initsize, time, npts, nflop, nproc)
  94.        end do ! loop for op
  95.       end do ! loop for k
  96. c
  97. c     testing mixed operations (single)
  98. c
  99.       step = 3
  100.       write (6,*) ' '
  101.       write (6,*) 'ADAPTOR:  mixed operations'
  102.       write (6,*) '=========================='
  103.       write (6,*) ' '
  104.  
  105.       do k = 1, 3
  106.        do op = 1, 3
  107.          size = initsize
  108.          do i = 1, npts
  109.             if (k .eq. 1)
  110.      &         call scombops (op, size, nproc, time(i), nflop)
  111.             if (k .eq. 2)
  112.      &         call dcombops (op, size, nproc, time(i), nflop)
  113.             if (k .eq. 3)
  114.      &         call icombops (op, size, nproc, time(i), nflop)
  115.             time(i) = time(i) - tover
  116. c           write (6,*) 'size = ', size, ' time = ', time(i)
  117.             size = size * 2
  118.          end do
  119.          call info (step, op, k, nflop)
  120.          call output (initsize,time, npts, nflop, nproc)
  121.        end do
  122.       end do
  123. c
  124. c     testing intrinsic functions
  125. c
  126.       step = 4
  127.       write (6,*) ' '
  128.       write (6,*) 'ADAPTOR:    intrinsic functions'
  129.       write (6,*) '==============================='
  130.       write (6,*) ' '
  131.       write (6,*) ' z (1:size,1:nproc) = f (x(:,:)) '
  132.       write (6,*) ' '
  133.  
  134.       do k = 1, 2
  135.        do op = 1, 3
  136.          size = initsize
  137.          do i = 1, npts
  138.             if (k .eq. 1)
  139.      &        call sintrinsics (op, size, nproc, time(i))
  140.             if (k .eq. 2)
  141.      &        call dintrinsics (op, size, nproc, time(i))
  142.             time(i) = time(i) - tover
  143. c           write (6,*) 'size = ', size, ' time = ', time(i)
  144.             size = size * 2
  145.          end do
  146.          call info (step, op, k, nflop)
  147.          call output (initsize,time, npts, nflop, nproc)
  148.        end do  ! loop for op
  149.       end do  ! loop for k
  150.       write (6,*) 'Benchmark ready'
  151.       end
  152. c
  153.       subroutine output (initsize,time, npts, nflop, nproc)
  154.       implicit none
  155.       integer initsize,npts, nflop, nproc
  156.       real time (npts)
  157. cmf$  layout time (:serial)
  158.       integer i, size
  159.       real usec, mops, mflops
  160.       write (6,*) ' size     usec    MOps(1)  MOps(n)  MFlops(n)'
  161.       do i = 1, npts
  162.         size = initsize * 2**(i-1)
  163.         usec = time(i) * 1e6
  164.         mops = 1e-6*size/time(i)
  165.         mflops = mops * nflop
  166.         write (6, '(i5,f11.2,3f9.3)') size, usec, mops, mops*nproc, 
  167.      &                                mflops*nproc
  168.       end do
  169.       write (6,*) ' '
  170.       end
  171.  
  172.       subroutine info (step, op, kind, nflop)
  173. c
  174. c     print info to step with operation op and type kind
  175. c
  176. c     return number of flop for the operation
  177. c
  178.       implicit none
  179.       integer step, op, kind, nflop
  180. c
  181.       nflop = 1
  182. c
  183.       if (step .eq. 1) then
  184.          if (op .eq. 1) write (6,*) 'z = 3    '
  185.          if (op .eq. 2) write (6,*) 'z(::s) = 3'
  186.          if (op .eq. 3) write (6,*) 'z = [1:n]   '
  187.          if (op .eq. 4) write (6,*) 'z = x       '
  188.          if (op .eq. 5) write (6,*) 'z = random()'
  189.       end if
  190.       if (step .eq. 2) then
  191.          if (op .eq. 1) write (6,*) 'z = x + y     (1 Flop)'
  192.          if (op .eq. 2) write (6,*) 'z = x * c     (1 Flop)'
  193.          if (op .eq. 3) write (6,*) 'z = x * y     (1 Flop)'
  194.          if (op .eq. 4) write (6,*) 'z = x / y     (4 Flops)'
  195.          if (op .eq. 5) write (6,*) 'where +/-     (1 Flops)'
  196.          if (op .eq. 6) write (6,*) 'z(:5)= +      (1 Flops)'
  197.          if (op .eq. 4) nflop = 4
  198.        end if
  199.       if (step .eq. 3) then
  200.          if (op .eq. 1) write(6,*) 'z = x + c * y            (2 Flop)'
  201.          if (op .eq. 2) write(6,*) 'z=0, z+=c1*x, z+=c2*y    (4 Flop)'
  202.          if (op .eq. 3) write(6,*) 'z=c1*x+c2*y, z=c1*z-c2*x (6 Flop)'
  203.          if (op .eq. 1) nflop = 2
  204.          if (op .eq. 2) nflop = 4
  205.          if (op .eq. 3) nflop = 6
  206.       end if
  207.       if (step .eq. 4) then
  208.          if (op .eq. 1) write (6,*) 'z = sin(x)  (8 Flops)'
  209.          if (op .eq. 2) write (6,*) 'z = exp(x)  (8 Flops)'
  210.          if (op .eq. 3) write (6,*) 'z = sqrt(x) (4 Flops)'
  211.          if (op .eq. 1) nflop = 8
  212.          if (op .eq. 2) nflop = 8
  213.          if (op .eq. 3) nflop = 4
  214.       end if
  215.       if (kind .eq. 1) write (6,*) 'single precision'
  216.       if (kind .eq. 2) write (6,*) 'double precision'
  217.       if (kind .eq. 3) write (6,*) 'integer'
  218.       end
  219.  
  220. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  221. C                                     C
  222. C     measure movements               C
  223. C                                     C
  224. C   1. Z = 3.0                        C
  225. C   2. Z = [1:n]                      C
  226. C   3. Z = X                          C
  227. C   4. Z = random                     C
  228. C                                     C
  229. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  230.  
  231.       subroutine smoves (op, size, nproc, time)
  232.       integer op, size, nproc
  233.       real time, t0, t1
  234.       real x(size*nproc), z(size*nproc), val, check
  235.       integer i, nloop, s
  236.       x = 1.5
  237.       nloop = 1
  238.  10   if (op .eq. 1) then
  239.         call walltime (t0)
  240.         do i = 1, nloop
  241.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  242.            z = 3.0
  243.         end do
  244.         call walltime (t1)
  245.         check = z(1)
  246.        else if (op .eq. 2) then
  247.         call stride (s)
  248.         call walltime (t0)
  249.         do i = 1, nloop
  250.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  251.            z(::s) = 3.0
  252.         end do
  253.         call walltime (t1)
  254.         check = z(1)
  255.        else if (op .eq. 3) then
  256.         call walltime (t0)
  257.         do i = 1, nloop
  258.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  259.            z = [1:size*nproc]
  260.         end do
  261.         call walltime (t1)
  262.         check = z(1)
  263.        else if (op .eq. 4) then
  264.         call walltime (t0)
  265.         do i = 1, nloop
  266.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  267.            z = x
  268.         end do
  269.         call walltime (t1)
  270.         check = z(1)
  271.        else if (op .eq. 5) then
  272.         call walltime (t0)
  273.         do i = 1, nloop
  274.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  275.            call cmf_random (z)
  276.         end do
  277.         call walltime (t1)
  278.         check = z(1)
  279.        else
  280.         write (6,*) 'operation error in moves'
  281.       end if
  282.       time = t1 - t0
  283.       call nloopupdate (time, nloop)
  284.       if (nloop .gt. 0) goto 10
  285. c     write (6,*) 'moves = ', op, ' Check = ', check
  286.       end
  287.  
  288.       subroutine dmoves (op, size, nproc, time)
  289.       integer op, size, nproc
  290.       real time, t0, t1
  291.       double precision x(size*nproc), z(size*nproc), val, check
  292.       integer i, nloop, s
  293.       x = 1.5
  294.       nloop = 1
  295.  10   if (op .eq. 1) then
  296.         call walltime (t0)
  297.         do i = 1, nloop
  298.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  299.            z = 3.0
  300.         end do
  301.         call walltime (t1)
  302.         check = z(1)
  303.        else if (op .eq. 2) then
  304.         call stride (s)
  305.         call walltime (t0)
  306.         do i = 1, nloop
  307.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  308.            z(::s) = 3.0
  309.         end do
  310.         call walltime (t1)
  311.         check = z(1)
  312.        else if (op .eq. 3) then
  313.         call walltime (t0)
  314.         do i = 1, nloop
  315.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  316.            z = [1:size*nproc]
  317.         end do
  318.         call walltime (t1)
  319.         check = z(1)
  320.        else if (op .eq. 4) then
  321.         call walltime (t0)
  322.         do i = 1, nloop
  323.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  324.            z = x
  325.         end do
  326.         call walltime (t1)
  327.         check = z(1)
  328.        else if (op .eq. 5) then
  329.         call walltime (t0)
  330.         do i = 1, nloop
  331.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  332.            call cmf_random (z)
  333.         end do
  334.         call walltime (t1)
  335.         check = z(1)
  336.        else
  337.         write (6,*) 'operation error in moves'
  338.       end if
  339.       time = t1 - t0
  340.       call nloopupdate (time, nloop)
  341.       if (nloop .gt. 0) goto 10
  342. c     write (6,*) 'moves = ', op, ' Check = ', check
  343.       end
  344.  
  345.       subroutine imoves (op, size, nproc, time)
  346.       integer op, size, nproc
  347.       real time, t0, t1
  348.       integer x(size*nproc), z(size*nproc), val, check
  349.       integer i, nloop, s
  350.       x = 13
  351.       nloop = 1
  352.  10   if (op .eq. 1) then
  353.         call walltime (t0)
  354.         do i = 1, nloop
  355.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  356.            z = 3
  357.         end do
  358.         call walltime (t1)
  359.         check = z(1)
  360.        else if (op .eq. 2) then
  361.         call stride (s)
  362.         call walltime (t0)
  363.         do i = 1, nloop
  364.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  365.            z(::s) = 3
  366.         end do
  367.         call walltime (t1)
  368.         check = z(1)
  369.        else if (op .eq. 3) then
  370.         call walltime (t0)
  371.         do i = 1, nloop
  372.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  373.            z = [1:size*nproc]
  374.         end do
  375.         call walltime (t1)
  376.         check = z(1)
  377.        else if (op .eq. 4) then
  378.         call walltime (t0)
  379.         do i = 1, nloop
  380.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  381.            z = x
  382.         end do
  383.         call walltime (t1)
  384.         check = z(1)
  385.        else if (op .eq. 5) then
  386.         call walltime (t0)
  387.         do i = 1, nloop
  388.            if (i .gt. nloop) call dummy1 (i, nloop, x, x, z)
  389.            call cmf_random (z,100)
  390.         end do
  391.         call walltime (t1)
  392.         check = z(1)
  393.        else
  394.         write (6,*) 'operation error in moves'
  395.       end if
  396.       time = t1 - t0
  397.       call nloopupdate (time, nloop)
  398.       if (nloop .gt. 0) goto 10
  399. c     write (6,*) 'moves = ', op, ' Check = ', check
  400.       end
  401.  
  402. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  403. C                                     C
  404. C     measure binary operations       C
  405. C                                     C
  406. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  407.  
  408.       subroutine sbinops (op, size, nproc, time)
  409.       integer op, size, nproc
  410.       real time, t0, t1
  411.       real x(size*nproc), y(size*nproc), z(size*nproc), val, check
  412.       integer i, nloop, s
  413.       x = 1.5
  414.       y = 3.0
  415.       val = 2.1
  416.       nloop = 1
  417.  10   if (op .eq. 1) then
  418.         call walltime (t0)
  419.         do i = 1, nloop
  420.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  421.            z = x + y
  422.         end do
  423.         call walltime (t1)
  424.         check = z(1)
  425.        else if (op .eq. 2) then
  426.         call walltime (t0)
  427.         do i = 1, nloop
  428.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  429.            z = x * val
  430.         end do
  431.         call walltime (t1)
  432.         check = z(1)
  433.        else if (op .eq. 3) then
  434.         call walltime (t0)
  435.         do i = 1, nloop
  436.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  437.            z = x * y
  438.         end do
  439.         call walltime (t1)
  440.         check = z(1)
  441.        else if (op .eq. 4) then
  442.         call walltime (t0)
  443.         do i = 1, nloop
  444.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  445.            z = x / y
  446.         end do
  447.         call walltime (t1)
  448.         check = z(1)
  449.        else if (op .eq. 5) then
  450.         call cmf_random (x)
  451.         call walltime (t0)
  452.         do i = 1, nloop
  453.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  454.            where (x .gt. 0.5)
  455.               z = y - x
  456.             elsewhere
  457.               z = y + x
  458.            endwhere
  459.         end do
  460.         call walltime (t1)
  461.         check = z(1)
  462.        else if (op .eq. 6) then
  463.         call stride (s)
  464.         call walltime (t0)
  465.         do i = 1, nloop
  466.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  467.            z(::s) = x(::s) + y(::s)
  468.         end do
  469.         call walltime (t1)
  470.         check = z(1)
  471.        else
  472.         write (6,*) 'operation error in binops'
  473.       end if
  474.       time = t1 - t0
  475.       call nloopupdate (time, nloop)
  476.       if (nloop .gt. 0) goto 10
  477. c     write (6,*) 'Binop = ', op, ' Check = ', check
  478.       end
  479.  
  480.       subroutine dbinops (op, size, nproc, time)
  481.       integer op, size, nproc
  482.       real time, t0, t1
  483.       double precision x(size*nproc), y(size*nproc)
  484.       double precision z(size*nproc), val, check
  485.       integer i, nloop, s
  486.       x = 1.5
  487.       y = 3.0
  488.       val = 2.1
  489.       nloop = 1
  490.  10   if (op .eq. 1) then
  491.         call walltime (t0)
  492.         do i = 1, nloop
  493.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  494.            z = x + y
  495.         end do
  496.         call walltime (t1)
  497.         check = z(1)
  498.        else if (op .eq. 2) then
  499.         call walltime (t0)
  500.         do i = 1, nloop
  501.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  502.            z = x * val
  503.         end do
  504.         call walltime (t1)
  505.         check = z(1)
  506.        else if (op .eq. 3) then
  507.         call walltime (t0)
  508.         do i = 1, nloop
  509.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  510.            z = x * y
  511.         end do
  512.         call walltime (t1)
  513.         check = z(1)
  514.        else if (op .eq. 4) then
  515.         call walltime (t0)
  516.         do i = 1, nloop
  517.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  518.            z = x / y
  519.         end do
  520.         call walltime (t1)
  521.         check = z(1)
  522.        else if (op .eq. 5) then
  523.         call cmf_random (x)
  524.         call walltime (t0)
  525.         do i = 1, nloop
  526.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  527.            where (x .gt. 0.5)
  528.               z = y - x
  529.             elsewhere
  530.               z = y + x
  531.            endwhere
  532.         end do
  533.         call walltime (t1)
  534.         check = z(1)
  535.        else if (op .eq. 6) then
  536.         call stride (s)
  537.         call walltime (t0)
  538.         do i = 1, nloop
  539.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  540.            z(::s) = x(::s) + y(::s)
  541.         end do
  542.         call walltime (t1)
  543.         check = z(1)
  544.        else
  545.         write (6,*) 'operation error in binops'
  546.       end if
  547.       time = t1 - t0
  548.       call nloopupdate (time, nloop)
  549.       if (nloop .gt. 0) goto 10
  550. c     write (6,*) 'Binop = ', op, ' Check = ', check
  551.       end
  552.  
  553.       subroutine ibinops (op, size, nproc, time)
  554.       integer op, size, nproc
  555.       real time, t0, t1
  556.       integer x(size*nproc), y(size*nproc)
  557.       integer z(size*nproc), val, check
  558.       integer i, nloop, s
  559.       x = 7
  560.       y = 3
  561.       val = 2
  562.       nloop = 1
  563.  10   if (op .eq. 1) then
  564.         call walltime (t0)
  565.         do i = 1, nloop
  566.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  567.            z = x + y
  568.         end do
  569.         call walltime (t1)
  570.         check = z(1)
  571.        else if (op .eq. 2) then
  572.         call walltime (t0)
  573.         do i = 1, nloop
  574.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  575.            z = x * val
  576.         end do
  577.         call walltime (t1)
  578.         check = z(1)
  579.        else if (op .eq. 3) then
  580.         call walltime (t0)
  581.         do i = 1, nloop
  582.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  583.            z = x * y
  584.         end do
  585.         call walltime (t1)
  586.         check = z(1)
  587.        else if (op .eq. 4) then
  588.         call walltime (t0)
  589.         do i = 1, nloop
  590.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  591.            z = x / y
  592.         end do
  593.         call walltime (t1)
  594.         check = z(1)
  595.        else if (op .eq. 5) then
  596.         call cmf_random (x,10)
  597.         call walltime (t0)
  598.         do i = 1, nloop
  599.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  600.            where (x .gt. 5)
  601.               z = y - x
  602.             elsewhere
  603.               z = y + x
  604.            endwhere
  605.         end do
  606.         call walltime (t1)
  607.         check = z(1)
  608.        else if (op .eq. 6) then
  609.         call stride (s)
  610.         call walltime (t0)
  611.         do i = 1, nloop
  612.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  613.            z(::s) = x(::s) + y(::s)
  614.         end do
  615.         call walltime (t1)
  616.         check = z(1)
  617.        else
  618.         write (6,*) 'operation error in binops'
  619.       end if
  620.       time = t1 - t0
  621.       call nloopupdate (time, nloop)
  622.       if (nloop .gt. 0) goto 10
  623. c     write (6,*) 'Binop = ', op, ' Check = ', check
  624.       end
  625.  
  626. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  627. C                                     C
  628. C     measure combined operations     C
  629. C                                     C
  630. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  631.  
  632.       subroutine scombops (op, size, nproc, time, nflop)
  633.       integer op, size, nproc, nflop
  634.       real time, t0, t1
  635.       real x(size*nproc), y(size*nproc), z(size*nproc), check
  636.       real val, val1, val2
  637.       integer i, nloop
  638.       x = 1.5
  639.       y = 3.0
  640.       val  = 2.1
  641.       val1 = 1.8
  642.       val2 = 3.7
  643.       nloop = 1
  644.  10   if (op .eq. 1) then
  645.         call walltime (t0)
  646.         do i = 1, nloop
  647.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  648.            z = x + val * y
  649.         end do
  650.         call walltime (t1)
  651.         nflop = 2
  652.         check = z(1)
  653.        else if (op .eq. 2) then
  654.         call walltime (t0)
  655.         do i = 1, nloop
  656.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  657.            z = 0
  658.            z = z + val  * x
  659.            z = z + val1 * y
  660.         end do
  661.         call walltime (t1)
  662.         nflop = 4
  663.         check = z(1)
  664.        else if (op .eq. 3) then
  665.         call walltime (t0)
  666.         do i = 1, nloop
  667.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  668.            z = val * x + val1 * y
  669.            z = val * z - val1 * x
  670.         end do
  671.         call walltime (t1)
  672.         nflop = 6
  673.         check = z(1)
  674.        else
  675.         write (6,*) 'operation error in combops'
  676.       end if
  677.       time = t1 - t0
  678.       call nloopupdate (time, nloop)
  679.       if (nloop .gt. 0) goto 10
  680. c     write (6,*) 'Combop = ', op, ' Check = ', check
  681.       end
  682.  
  683.       subroutine dcombops (op, size, nproc, time, nflop)
  684.       integer op, size, nproc, nflop
  685.       real time, t0, t1
  686.       double precision x(size*nproc), y(size*nproc), z(size*nproc)
  687.       double precision check, val, val1, val2
  688.       integer i, nloop
  689.       x = 1.5
  690.       y = 3.0
  691.       val  = 2.1
  692.       val1 = 1.8
  693.       val2 = 3.7
  694.       nloop = 1
  695.  10   if (op .eq. 1) then
  696.         call walltime (t0)
  697.         do i = 1, nloop
  698.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  699.            z = x + val * y
  700.         end do
  701.         call walltime (t1)
  702.         nflop = 2
  703.         check = z(1)
  704.        else if (op .eq. 2) then
  705.         call walltime (t0)
  706.         do i = 1, nloop
  707.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  708.            z = 0.0
  709.            z = z + val  * x
  710.            z = z + val1 * y
  711.         end do
  712.         call walltime (t1)
  713.         nflop = 4
  714.         check = z(1)
  715.        else if (op .eq. 3) then
  716.         call walltime (t0)
  717.         do i = 1, nloop
  718.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  719.            z = val * x + val1 * y
  720.            z = val * z - val1 * x
  721.         end do
  722.         call walltime (t1)
  723.         nflop = 6
  724.         check = z(1)
  725.        else
  726.         write (6,*) 'operation error in combops'
  727.       end if
  728.       time = t1 - t0
  729.       call nloopupdate (time, nloop)
  730.       if (nloop .gt. 0) goto 10
  731. c     write (6,*) 'Combop = ', op, ' Check = ', check
  732.       end
  733.  
  734.       subroutine icombops (op, size, nproc, time, nflop)
  735.       integer op, size, nproc, nflop
  736.       real time, t0, t1
  737.       integer x(size*nproc), y(size*nproc), z(size*nproc)
  738.       integer check, val, val1, val2
  739.       integer i, nloop
  740.       x = 15
  741.       y = 30
  742.       val  = 21
  743.       val1 = 18
  744.       val2 = 37
  745.       nloop = 1
  746.  10   if (op .eq. 1) then
  747.         call walltime (t0)
  748.         do i = 1, nloop
  749.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  750.            z = x + val * y
  751.         end do
  752.         call walltime (t1)
  753.         nflop = 2
  754.         check = z(1)
  755.        else if (op .eq. 2) then
  756.         call walltime (t0)
  757.         do i = 1, nloop
  758.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  759.            z = 0
  760.            z = z + val  * x
  761.            z = z + val1 * y
  762.         end do
  763.         call walltime (t1)
  764.         nflop = 4
  765.         check = z(1)
  766.        else if (op .eq. 3) then
  767.         call walltime (t0)
  768.         do i = 1, nloop
  769.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, z)
  770.            z = val * x + val1 * y
  771.            z = val * z - val1 * x
  772.         end do
  773.         call walltime (t1)
  774.         nflop = 6
  775.         check = z(1)
  776.        else
  777.         write (6,*) 'operation error in combops'
  778.       end if
  779.       time = t1 - t0
  780.       call nloopupdate (time, nloop)
  781.       if (nloop .gt. 0) goto 10
  782. c     write (6,*) 'Combop = ', op, ' Check = ', check
  783.       end
  784.  
  785. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  786. C                                     C
  787. C     measure intrinsics              C
  788. C                                     C
  789. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  790.  
  791.       subroutine sintrinsics (op, size, nproc, time)
  792.       integer op, size, nproc
  793.       real time, t0, t1
  794.       real x(size*nproc), y(size*nproc), check
  795.       integer i, nloop
  796.       x = 3.0
  797.       nloop = 1
  798.  10   if (op .eq. 1) then
  799.         call walltime (t0)
  800.         do i = 1, nloop
  801.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, x)
  802.            y = sin(x)    
  803.         end do
  804.         call walltime (t1)
  805.         check = y(1)
  806.        else if (op .eq. 2) then
  807.         call walltime (t0)
  808.         do i = 1, nloop
  809.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, x)
  810.            y = exp(x)
  811.         end do
  812.         call walltime (t1)
  813.         check = y(1)
  814.        else if (op .eq. 3) then
  815.         call walltime (t0)
  816.         do i = 1, nloop
  817.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, x)
  818.            y = sqrt (x)
  819.         end do
  820.         call walltime (t1)
  821.         check = y(1)
  822.        else
  823.         write (6,*) 'operation error in intrinsics'
  824.       end if
  825.       time = t1 - t0
  826.       call nloopupdate (time, nloop)
  827.       if (nloop .gt. 0) goto 10
  828. c     write (6,*) 'Intrinsic = ', op, ' Check = ', check
  829.       end
  830.  
  831.       subroutine dintrinsics (op, size, nproc, time)
  832.       integer op, size, nproc
  833.       real time, t0, t1
  834.       double precision x(size*nproc), y(size*nproc), check
  835.       integer i, nloop
  836.       x = 3.0
  837.       nloop = 1
  838.  10   if (op .eq. 1) then
  839.         call walltime (t0)
  840.         do i = 1, nloop
  841.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, x)
  842.            y = sin(x)    
  843.         end do
  844.         call walltime (t1)
  845.         check = y(1)
  846.        else if (op .eq. 2) then
  847.         call walltime (t0)
  848.         do i = 1, nloop
  849.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, x)
  850.            y = exp(x)
  851.         end do
  852.         call walltime (t1)
  853.         check = y(1)
  854.        else if (op .eq. 3) then
  855.         call walltime (t0)
  856.         do i = 1, nloop
  857.            if (i .gt. nloop) call dummy1 (i, nloop, x, y, x)
  858.            y = sqrt (x)
  859.         end do
  860.         call walltime (t1)
  861.         check = y(1)
  862.        else
  863.         write (6,*) 'operation error in intrinsics'
  864.       end if
  865.       time = t1 - t0
  866.       call nloopupdate (time, nloop)
  867.       if (nloop .gt. 0) goto 10
  868. c     write (6,*) 'Intrinsic = ', op, ' Check = ', check
  869.       end
  870.  
  871. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  872. C                                     C
  873. C     loop handling                   C
  874. C                                     C
  875. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  876.  
  877.       subroutine nloopupdate (time, n)
  878.       real time, runtime
  879.       parameter (runtime = 1.0)
  880.       integer n
  881.       if (time .lt. 0.1) then 
  882.          n = n * 10
  883.        else if (time .lt. (runtime / 2.0)) then
  884.          n = n * (runtime / time)
  885.         else
  886.          time = time / n
  887.          n = 0
  888.        end if 
  889.       end
  890.  
  891. c     the next subroutine measures the loop overhead
  892.  
  893.       subroutine overhead (tover)
  894.       real tover, t0, t1, x
  895.       integer i, nloop
  896.       nloop = 100000
  897.       call walltime (t0)
  898.       do i = 1, nloop
  899.         if (i .gt. nloop) call dummy (x)
  900.       end do
  901.       call walltime (t1)
  902.       tover = (t1 - t0) / nloop
  903.       write (6,*) 'Loop overhead ', tover, ' sec'
  904.       end 
  905.  
  906.       subroutine dummy (x)
  907.       real x
  908.       print *, 'dummy error, should never be really called'
  909.       end
  910.  
  911.       subroutine dummy1 (i, n, x, y, z)
  912.       integer i, n
  913.       real x(10), y(10), z(10)
  914.       print *, 'error in dummy1, should never be really called'
  915.       print *, 'i = ', i, ' n = ', n
  916.       stop
  917.       end
  918.  
  919.       subroutine stride (s)
  920.       integer s
  921.       s = 5 
  922.       end
  923.